home *** CD-ROM | disk | FTP | other *** search
AMOS Source Code | 1997-01-08 | 2.0 KB | 119 lines |
- Set Buffer 30
- Reserve As Work 15,320*256
- Dim C(31,31)
- Dim R(255),G(255),B(255)
- Bload "ab3:includes/256pal",Start(15)
- S=Start(15)
- For A=0 To 255
- R(A)=Deek(S) : Add S,2
- G(A)=Deek(S) : Add S,2
- B(A)=Deek(S) : Add S,2
- Next
-
- Dim PR(31,31),PG(31,31),PB(31,31)
- Repeat
- Screen Open 0,640,32,2,Hires
- Curs Off : Flash Off : Cls 0
- Colour 1,$FFF
-
- F$=Fsel$("ab3:graphics/walls","","Load Wall Picture","")
- If F$="" Then End
- Load Iff F$,1
-
- Bload F$,Start(15)
- S=Hunt(Start(15) To Start(15)+10000,"CMAP")+8
- For A=0 To 31
- PR(A,0)=Peek(S) : Add S,1
- PG(A,0)=Peek(S) : Add S,1
- PB(A,0)=Peek(S) : Add S,1
- Next
-
-
- T=Start(15)
-
- For A=0 To 7
- Poke T,0 : Add T,1
- Poke T,PR(A,0) : Add T,1
- Poke T,PG(A,0) : Add T,1
- Poke T,PB(A,0) : Add T,1
- Next
- Bsave "ab3:demo/menu/newfontpal",Start(15) To T
-
- End
-
-
- F$=F$-"ab3:graphics/walls/"
- Screen 0 : Screen To Front 0
- Input "Width of chunk: ";W
- Input "Height of chunk: ";H
- NOL=W/3
- NOL=NOL
- Screen 1 : Screen To Front 1
- X=0 : Y=0
- AP=Start(15)
-
- '
- For A=0 To 31
- For Q=0 To 31
-
- R=PR(Q,A) : G=PG(Q,A) : B=PB(Q,A)
-
- DQ=10000000
- TC=0
- For Z=0 To 255
- DR=Abs(R-R(Z))
- DG=Abs(G-G(Z))
- DB=Abs(B-B(Z))
-
- ND=(DR*3)+(DG*4)+(DB*2)
- If ND<DQ Then DQ=ND : TC=Z
- Next
-
- Doke AP,TC*256
- Add AP,2
-
- Next
- Next
-
- D=AP
- X=0 : Y=0
- For L=0 To NOL
- For V=0 To H-1
- C= Extension_12_044C(X,Y+V)
- Extension_12_036E X,Y+V,0
- Doke D,C : Add D,2
- Next
- Add X,3
- If X>=Screen Width(1) Then X=X-Screen Width(1) : Y=Y+H
- Next
- D=AP
- X=1 : Y=0
- For L=0 To NOL
- For V=0 To H-1
- C= Extension_12_044C(X,Y+V)*32
- Extension_12_036E X,Y+V,0
- Doke D,C+Deek(D)
- Add D,2
- Next
- Add X,3
- If X>=Screen Width(1) Then X=X-Screen Width(1) : Y=Y+H
- Next
- D=AP
- X=2 : Y=0
- For L=0 To NOL
- For V=0 To H-1
- C= Extension_12_044C(X,Y+V)*32*32
- Extension_12_036E X,Y+V,0
- Doke D,C+Deek(D)
- Add D,2
- Next
- Add X,3
- If X>=Screen Width(1) Then X=X-Screen Width(1) : Y=Y+H
- Next
-
- Doke D,H : Add D,2
-
- F$=Fsel$("ab3:includes/Walls",F$,"Select Save Name","")
- If F$="" Then End
- Bsave F$+".256wad",Start(15) To D
- Until 0